home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / prefs.tcl < prev    next >
Text File  |  1996-01-23  |  7KB  |  321 lines
  1.  
  2.  
  3. #===============================================================================
  4.  
  5.  
  6. proc addArrDef {arr def val} {
  7.     addDef [list $arr $def] $val arr
  8. }
  9.  
  10. proc removeArrDef {arr def} {
  11.     removeDef [list $arr $def] arr
  12. }
  13.  
  14. proc addDef {def val {prefix {}}} {
  15.     global ${prefix}prefDefs
  16.     
  17.     readDefs $prefix
  18.     set ${prefix}prefDefs($def) $val
  19.     writeDefs $prefix
  20.     catch {unset ${prefix}prefDefs}
  21. }
  22.  
  23. proc removeDef {def {prefix {}}} {
  24.     global ${prefix}prefDefs
  25.     
  26.     readDefs $prefix
  27.     catch {unset ${prefix}prefDefs($def)}
  28.     writeDefs $prefix
  29.     catch {unset ${prefix}prefDefs}
  30. }
  31.  
  32. proc readDefs {{prefix {}}} {
  33.     global HOME PREFS globalPrefix
  34.  
  35.     if {![file exists "$PREFS:${prefix}defs.tcl"]} return
  36.     
  37.     set globalPrefix $prefix
  38.     uplevel #0 {source "$PREFS:${globalPrefix}defs.tcl"}
  39. }
  40.  
  41.  
  42. proc writeDefs {{prefix {}}} {
  43.     global HOME PREFS ${prefix}prefDefs 
  44.     
  45.     if {![info exists ${prefix}prefDefs]} {
  46.         catch {removeFile "$PREFS:${prefix}defs.tcl"}
  47.         return
  48.     }
  49.     
  50.     if {![file exists "$PREFS"]} {
  51.         mkdir "$PREFS"
  52.     }
  53.     set fd [open "$PREFS:${prefix}defs.tcl" "w"]
  54.     foreach nm [array names ${prefix}prefDefs] {
  55.         puts $fd [list set ${prefix}prefDefs($nm) [set ${prefix}prefDefs($nm)]]
  56.     }
  57.     close $fd
  58. }
  59.  
  60.  
  61. proc readUserDefs {} {
  62.     global prefDefs arrprefDefs PREFS
  63.     
  64.     if {[file exists "$PREFS:defs.tcl"]} {
  65.         source "$PREFS:defs.tcl"
  66.         
  67.         foreach nm [array names prefDefs] {
  68.             global $nm
  69.             set $nm $prefDefs($nm)
  70.         }
  71.         catch {unset prefDefs}
  72.     }
  73.     
  74.     if {[file exists "$PREFS:arrdefs.tcl"]} {
  75.         source "$PREFS:arrdefs.tcl"
  76.         
  77.         foreach nm [array names arrprefDefs] {
  78.             set arr [lindex $nm 0]
  79.             set field [lindex $nm 1]
  80.             set val $arrprefDefs($nm)
  81.             global $arr
  82.             set ${arr}($field) $val
  83.         }
  84.         catch {unset arrprefDefs}
  85.     }
  86.  
  87.     # Use "prefs.tcl" to define or change any tcl information. */
  88.     if {![file exists "$PREFS:prefs.tcl"]} {
  89.         
  90.         if {![file exists "$PREFS"]} {
  91.             mkdir "$PREFS"
  92.         }
  93.         set fd [open "$PREFS:prefs.tcl" "w"]
  94.         close $fd
  95.     }
  96.     uplevel #0 {
  97.         if {[catch {source "$PREFS:prefs.tcl"}]} {
  98.             alertnote "An error occurred while loading \"prefs.tcl\"" 
  99.         }
  100.     }
  101. }
  102.  
  103.     
  104. proc viewSavedSetting {} {
  105.     global prefDefs arrprefDefs
  106.  
  107.     saveModifiedVars
  108.     
  109.     readDefs
  110.     readDefs arr
  111.     
  112.     set res [listpick -p "The following settings have been saved:" [getSavedSettings]]
  113.  
  114.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  115.         set arg [list $arr $field]
  116.         set val $arrprefDefs($arg)
  117.         if {[string length $val] > 80} {
  118.             global tileLeft tileTop tileWidth
  119.             new -g $tileLeft $tileTop $tileWidth 100 -n "\$${arr}($field)"
  120.             insertText "'$res's value is:\r\r$val\r"
  121.             setWinInfo read-only 1
  122.             setWinInfo dirty 0
  123.             goto 0
  124.         } else {
  125.             alertnote "'$res's value is:\r\r$val\r"
  126.         }
  127.     } else {
  128.         global $res
  129.         alertnote "'$res's value is:\r\r$prefDefs($res)"
  130.     }
  131.  
  132.     unset prefDefs arrprefDefs
  133. }
  134.  
  135. proc removeSavedSetting {} {
  136.     global prefDefs arrprefDefs
  137.     
  138.     saveModifiedVars
  139.     
  140.     readDefs
  141.     readDefs arr
  142.     set res [listpick -p "Remove which setting?" [lsort -ignore [getSavedSettings]]]
  143.  
  144.     if {$res == ""} return
  145.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  146.         global $arr
  147. #         catch {unset ${arr}($field)}
  148.         removeArrDef $arr $field
  149.     } else {
  150.         global $res
  151. #         catch {unset $res}
  152.         removeDef $res
  153.     }
  154.  
  155.     unset prefDefs arrprefDefs
  156. }
  157.  
  158.  
  159. proc getSavedSettings {} {
  160.     global prefDefs arrprefDefs
  161.     
  162.     readDefs
  163.     readDefs arr
  164.     
  165.     set names [array names prefDefs]
  166.     foreach pair [array names arrprefDefs] {
  167.         lappend names "[lindex $pair 0]([lindex $pair 1])"
  168.     }
  169.     
  170.     return [lsort $names]
  171. }
  172.  
  173. #===============================================================================
  174.  
  175. proc buildRecentFiles {} {
  176.     global recentFilesSave recentFiles modifiedVars
  177.     
  178.     lappend modifiedVars
  179.     
  180.     message "Building recent files menu╔"
  181.     if {[info exists recentFiles]} {
  182.         set recentFilesSave $recentFiles
  183.     }
  184.     if {[info exists recentFilesSave]} {
  185.         foreach f $recentFilesSave {
  186.             pushRecent $f
  187.         }
  188.     }
  189.         
  190.     catch {unset recentFilesSave}
  191. }
  192.  
  193.  
  194. proc pushRecent {name} {
  195.     global recentFiles alphaLite
  196.     
  197.     if {[string match {*\**} $name] || [string match "Untit*" $name] } return
  198.     if {[info exists recentFiles] && ([set ind [lsearch -glob $recentFiles "*[file tail $name]"]] >= 0)} {
  199.         set recentFiles [lreplace $recentFiles $ind $ind]
  200.     }
  201.     lappend recentFiles $name
  202.     if {[llength $recentFiles] > 10} {
  203.         set recentFiles [lrange $recentFiles 1 end]
  204.     }
  205.     foreach f $recentFiles {
  206.         lappend tails [file tail $f]
  207.     }
  208.     if {$alphaLite} {
  209.         set name Recent
  210.     } else {
  211.         set name recent
  212.     }
  213.     menu -m -n $name -p recentProc [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
  214. }
  215.  
  216. proc recentProc {menu name} {
  217.     global recentFiles
  218.     
  219.     if {$name == "Reset List"} {
  220.         unset recentFiles
  221.         menu -m -n recent -p recentProc {}
  222.     } else {
  223.         if {[set ind [lsearch $recentFiles "*:$name"]] >= 0} {
  224.             edit [lindex $recentFiles $ind]
  225.         }
  226.     }
  227. }
  228.  
  229.  
  230. proc editRecentFile {} {
  231.     global recentFiles
  232.     
  233.     foreach f $recentFiles {
  234.         lappend tails [file tail $f]
  235.     }
  236.     
  237.     foreach res [listpick -l -p {File?} [lsort -ignore $tails]]  {
  238.         set ind [lsearch $recentFiles \*:$res]
  239.         catch {edit [lindex $recentFiles $ind]}
  240.     }
  241. }
  242.  
  243.  
  244. #===============================================================================
  245.  
  246. proc editPrefs {} {
  247.     global PREFS
  248.     if {![file exists "$PREFS:prefs.tcl"]} {
  249.         set fd [open "$PREFS:prefs.tcl" "w"]
  250.         close $fd
  251.     }
  252.     edit "$PREFS:prefs.tcl"
  253. }
  254.  
  255. # Automatically add a line to the user input file
  256. proc addUserLine {line} {
  257.     global HOME PREFS
  258.  
  259.     if {![file exists "$PREFS"]} {
  260.         mkdir "$PREFS"
  261.     }
  262.     set fid [open "$PREFS:prefs.tcl" "a+"]
  263.     if {![catch {seek $fid -1 end}]} {
  264.         if {[read $fid 1] == "\r"} {
  265.             set line "\r$line"
  266.         }
  267.     }
  268.     seek $fid 0 end
  269.     puts $fid $line
  270.     close $fid
  271. }
  272.  
  273.  
  274.  
  275. #===============================================================================
  276.  
  277. proc sourceCurrentModePrefs {} { 
  278.     global mode PREFS
  279.     if {[file exists "${PREFS}:${mode}Prefs.tcl"]} {
  280.         source  "${PREFS}:${mode}Prefs.tcl"
  281.     } else {
  282.         beep; message "Sorry, no preferences for '$mode' mode"
  283.     }
  284. }
  285.  
  286.  
  287. proc editCurrentModePrefs {} { 
  288.     global mode
  289.     editPrefsProc modePrefs $mode
  290. }
  291.  
  292.  
  293. proc editPrefsProc { menu m } {
  294.     message $m
  295.     global PREFS mode
  296.     # assume it is a mode, since we made the menu
  297.     
  298.     set f "$PREFS:${m}Prefs.tcl"
  299.     if [file exists $f] {
  300.         edit $f
  301.     } else {
  302.         if { [askyesno "No '$m' prefs file exists, do you want to create one?"] \
  303.             == "yes" } {
  304.             
  305.             set fd [open $f "w"]
  306.             close $fd
  307.             edit $f
  308.             insertText {## 
  309.  # This    file will be sourced automatically, immediately after 
  310.  # the _first_ time    the    file which defines its mode is sourced.
  311.  # Use this    file to    insert your    own    mode-specific preferences
  312.  # and changes,    rather than    altering the originals.
  313.  # 
  314.  # You can redefine    menus, procedures, variables,...
  315.  ##
  316.  
  317. }}}
  318.             
  319. }
  320.  
  321.